home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #14 / Monster Media No. 14 (April 1996) (Monster Media, Inc.).ISO / prog_bas / netuser.zip / DATA / VB / NetUser / Conditional / Netuser.bas
BASIC Source File  |  1995-12-18  |  6KB  |  183 lines
  1. Attribute VB_Name = "NetworkUser"
  2. Option Explicit
  3. '
  4. '   This module will return the user name of the person who signed into
  5. '   the system. This module should work with the following operating
  6. '   systems: Windows 3.x, Windows for Workgroups, Windows 95 and
  7. '   Windows NT.
  8. '
  9. '   This module is written for conditional compilation. If your development
  10. '   environment does not support this, then you should choose the appropriate
  11. '   module for your environment.
  12. '
  13. '   If the user will be running a 16 bit program on Windows 95 or Windows NT
  14. '   then this module requires the CALL32.DLL file to function correctly. This
  15. '   DLL should be included with your application and copied to the users
  16. '   SYSTEM directory under windows.
  17. '
  18. ''''
  19. '
  20. '   Declare variables needed
  21. '
  22. Private glngReturnStatus As Long
  23. Private Const SUCCESS = 1&
  24. Private Const FAILURE = 0&
  25.  
  26. #If Win32 Then
  27.     Declare Function ADV_GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal strUser As String, lngBuffer As Long) As Long
  28. #Else
  29.     Dim mintInitialized As Integer
  30.     Dim mlngGetUserName As Long
  31.     
  32.     Const WV_WIN3X = 0
  33.     Const WV_WINWFW = 1
  34.     Const WV_WINNT = 2
  35.     Const WV_WIN95 = 3
  36. '
  37. '   API Declaration
  38. '
  39.     Declare Function KRN_GetVersion Lib "Kernel" Alias "GetVersion" () As Integer
  40.     Declare Function KRN_GetWinFlags Lib "Kernel" Alias "GetWinFlags" () As Integer
  41.     Declare Function USR_WNetGetCaps Lib "User" Alias "WNetGetCaps" (ByVal nIndex As Integer) As Integer
  42.     Declare Function WFW_MNetNetworkEnum Lib "WFWNET.DRV" Alias "MNetNetworkEnum" (nIndex As Integer) As Integer
  43.     Declare Function WFW_MNetSetNextTarget Lib "WFWNET.DRV" Alias "MNetSetNextTarget" (ByVal nIndex As Integer) As Integer
  44.     Declare Function USR_WNetGetUser Lib "User" Alias "WNetGetUser" (ByVal sUser As String, nBufferSize As Integer) As Integer
  45.     Declare Function Declare32& Lib "call32.dll" (ByVal func$, ByVal library$, ByVal args$)
  46.     Declare Function GetUserNameA Lib "call32.dll" Alias "call32" (ByVal strUser As String, lngUserBuffer As Long, ByVal lngID As Long) As Integer
  47. #End If
  48.  
  49.  
  50. Function NetworkUserID() As String
  51. '   This routine will get the name of the user signed onto the network.
  52. '   If no username is found it will return an UnknownUser string.
  53. '
  54.     Dim lngBufferSize As Long
  55.     Dim strUser As String
  56.     
  57.     On Error GoTo NetworkUserID_EH
  58.  
  59.     NetworkUserID = "UnknownUser"
  60.     
  61.     lngBufferSize = 255
  62.     strUser = Space$(lngBufferSize)
  63.  
  64. #If Win32 Then
  65.     glngReturnStatus = ADV_GetUserName(strUser, lngBufferSize)
  66.     If glngReturnStatus = SUCCESS Then
  67.         strUser = Left$(strUser, lngBufferSize - 1)
  68.     Else
  69.         Err = glngReturnStatus
  70.     End If
  71. #Else
  72. '
  73. '   Declare some variable/constants needed for 16-bit
  74. '
  75.     Dim intHandle As Integer
  76.     Dim intEnumerate As Integer
  77.     Dim intVersion As Integer
  78. '
  79. '   Get the users current windows version
  80. '
  81.     intVersion = WindowsVersion()
  82.     Select Case intVersion
  83.     Case WV_WIN3X
  84.         glngReturnStatus = USR_WNetGetUser(strUser, CInt(lngBufferSize))
  85.         If (glngReturnStatus = 0) Then
  86.             strUser = Left$(strUser, InStr(strUser, Chr(0)) - 1)
  87.         End If
  88.     Case WV_WINWFW
  89.         intHandle = 0
  90.         intEnumerate = 0
  91.         intEnumerate = WFW_MNetNetworkEnum(intHandle)
  92. '
  93. '   Scan through the networks until we get a name
  94. '
  95.         While (intEnumerate = 0)
  96.             glngReturnStatus = WFW_MNetSetNextTarget(intHandle)
  97.             glngReturnStatus = USR_WNetGetUser(strUser, CInt(lngBufferSize))
  98.             If (glngReturnStatus = 0) Then
  99.                 strUser = Left$(strUser, InStr(strUser, Chr(0)) - 1)
  100.             End If
  101.             intEnumerate = WFW_MNetNetworkEnum(intHandle)
  102.         Wend
  103.     Case WV_WINNT, WV_WIN95
  104. '
  105. '   Initialize and call the Win32 API function(s)
  106. '
  107.         mlngGetUserName = Declare32("GetUserNameA", "advapi32.dll", "pp")
  108.         glngReturnStatus = GetUserNameA(strUser, lngBufferSize, mlngGetUserName)
  109.         If glngReturnStatus <> SUCCESS Then
  110.             MsgBox "Problem during UserName, problem code is " & Error
  111.             strUser = "UnknownUser"
  112.             Exit Function
  113.         End If
  114.         strUser = Left$(strUser, lngBufferSize - 1)
  115.     End Select
  116. #End If
  117.     NetworkUserID = strUser
  118.     Exit Function
  119.  
  120. NetworkUserID_EH:
  121.     NetworkUserID = "ErrorInCall"
  122.     Exit Function
  123. End Function
  124.  
  125. Private Function WindowsVersion() As Integer
  126. '
  127. '   This routine will determine the DOS/Windows version(s).
  128. '   It will return the values back to the calling program.
  129. '
  130. #If Win32 Then
  131. #Else
  132.     Dim strLowByte As String
  133.     Dim strHighByte As String
  134.     Dim sglWindowsVersion As Single
  135.     Dim intNetwork As Integer
  136.     
  137.     Const WNNC_NET_MultiNet = &H8000
  138.     Const WNNC_SUBNET_WinWorkgroups = 4
  139.     Const WNNC_NET_TYPE = 2
  140.     Const WF_WINNT = &H4000
  141.  
  142.     On Error GoTo WindowsVersion_EH
  143.     
  144.     glngReturnStatus = KRN_GetWinFlags()
  145.     If glngReturnStatus And WF_WINNT Then
  146.         WindowsVersion = WV_WINNT
  147.     Else
  148. '
  149. '   Since Windows NT is not running, find the version of windows
  150. '
  151.         glngReturnStatus = KRN_GetVersion()
  152.         glngReturnStatus = glngReturnStatus And &HFFFF&
  153.         strLowByte = Trim$(CStr(glngReturnStatus And &HFF))
  154.         strHighByte = Trim$(CStr((glngReturnStatus And &HFF00) / 256))
  155.         sglWindowsVersion = CSng(strLowByte & "." & strHighByte)
  156.         
  157.         Select Case sglWindowsVersion
  158.         Case Is < 3.95                 ' User is not under Windows 95
  159. '
  160. '   Check to see if the user is running WFW 3.11
  161. '
  162.             intNetwork = USR_WNetGetCaps(WNNC_NET_TYPE)
  163.             If (intNetwork And WNNC_NET_MultiNet) Then
  164.                 If ((intNetwork And &HFFFF) And WNNC_SUBNET_WinWorkgroups) <> 0 Then
  165.                     WindowsVersion = WV_WINWFW
  166.                 Else
  167.                     WindowsVersion = WV_WIN3X
  168.                End If
  169.             Else
  170.                 WindowsVersion = WV_WIN3X
  171.             End If
  172.         Case Else
  173.             WindowsVersion = WV_WIN95
  174.         End Select
  175.     End If
  176.     Exit Function
  177.  
  178. WindowsVersion_EH:
  179.     MsgBox "Problem in WindowsVersion, problem is " & Err.Description
  180.     Exit Function
  181. #End If
  182. End Function
  183.